home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / Descargar.tcl < prev    next >
Encoding:
Text File  |  2004-03-09  |  27.8 KB  |  822 lines
  1. ###############################################################################
  2. ###############################################################################
  3. ##                               Descargar.tcl
  4. ###############################################################################
  5. ###############################################################################
  6. ## Includes the procedures needed for downloading a link
  7. ###############################################################################
  8. ###############################################################################
  9. ## (c) 2001-2004 AndrΘs Garcφa Garcφa. fandom@retemail.es
  10. ## You may distribute the contents of this file under the terms of the GPL v2
  11. ###############################################################################
  12. ###############################################################################
  13.  
  14. namespace eval Descargar {
  15.  
  16. ###############################################################################
  17. # CheckDir
  18. #    Creates, if needed, the directory in which the link will be saved.
  19. #
  20. # Parameter:
  21. #    fileName: file in which the url is going to be downloaded.
  22. #
  23. # Returns:
  24. #    1: In case of error
  25. ###############################################################################
  26. proc CheckDir {fileName} {
  27.     global labelTitles labelMessages
  28.  
  29.     set newDirectory [file dirname $fileName]
  30.     set tmpDir $newDirectory
  31.  
  32.     # This is a bit weird, so please be patient.
  33.     # There seems to be an Apache module that is a bit to helpful,
  34.     # if you request a file called 'http://www.domain.com/abc'
  35.     # and 'abc' is a directory, it returns 'abc/index.html' without
  36.     # telling anything, up until this 'Getleft' would create a file
  37.     # 'abc', which was nice and good until you had to download
  38.     # 'abc/something.html', so in that case we now delete the 
  39.     # 'helpful' file and continue.
  40.     while {[catch {file mkdir $newDirectory}]} {
  41.         if {![file exists $tmpDir]} {
  42.             set tmpDir [file dirname $tmpDir]
  43.         } else {
  44.             if {[catch {file delete $tmpDir}]} {
  45.                 return 1
  46.             }
  47.         }
  48.     }
  49.     return
  50. }
  51.  
  52. ###############################################################################
  53. # FileExists
  54. #    Checks whether the file we are going to download has already been 
  55. #    downloaded.
  56. #
  57. # Parameter:
  58. #    link: The url about to be downloaded
  59. #    fileName: Name of the file to check
  60. #    sufix: '1' if the fileName ends in 'html?' '0' otherwise.
  61. #
  62. # Returns:
  63. #    - '-1' the file does not exist.
  64. #    - '0' file exists and is not a Html page.
  65. #    - '1' file exists and is a Html page
  66. #    - '4' if it exists and the referrer page will have to change for it.
  67. ###############################################################################
  68. proc FileExists {link fileName sufix} {
  69.     global downOptions
  70.     variable relocated
  71.     variable downloaded
  72.  
  73.     if {[file exists $fileName]} {
  74.         if {($downOptions(update)==0)||[info exists "downloaded($link)"]} {
  75.             if {$sufix==0} {
  76.                 # It may so happen with CGI scripts that there is a directory
  77.                 # and a file with the same name, I wish webmasters stopped 
  78.                 # being clever about the names of CGI scripts, but there is
  79.                 # nothing I can do to stop them being stupid.
  80.                 if {([file isdirectory $fileName])&&(![regexp {/$} $fileName])} {
  81.                     if {[file exists $fileName/index.html]} {
  82.                         set relocated(url) $link/index.html
  83.                     } elseif {[file exists $fileName.html]} {
  84.                         set relocated(url) $link.html
  85.                     } else {
  86.                         set relocated(url) $link/index.html
  87.                         return -1
  88.                     }
  89.                     return 4
  90.                 } elseif {[file exists $fileName.html]} {
  91.                     return 1
  92.                 } else {
  93.                     return 0
  94.                 }
  95.             } else {
  96.                 return 1
  97.             }
  98.         }
  99.     }
  100.     return -1
  101. }
  102.  
  103. ###############################################################################
  104. # ConnectTimeout
  105. #    This procedure is invoked when Getleft fails to connect to the server
  106. #    in 60 seconds. Here it will be decided where to retry or abort.
  107. #
  108. # Returns:
  109. #    - '0' we try again.
  110. #    - '1' we cancel the download.
  111. ###############################################################################
  112. proc ConnectTimeout {link referer code} {
  113.     global getleftState getleftOptions labelCurlCodes labelMessages
  114.     global siteUrl
  115.  
  116.     incr getleftState(noConnect,$siteUrl(www))
  117.     getLog::FileLogEnter $code "$link" "$referer"
  118.     set getleftState(waiting) 1
  119.     set tmp $::Ventana::Rizo::curlReport(nextFile)
  120.     Ventana::ShowWindow wait
  121.     tkwait variable getleftState(waiting)
  122.     if {$getleftState(downloading)==0} {
  123.         return 1
  124.     }
  125.     if {$tmp!=$::Ventana::Rizo::curlReport(nextFile)} {
  126.         return 1
  127.     }
  128.     if {$getleftState(noConnect,$siteUrl(www))>10} {
  129.         if {$getleftState(autoDown)!=1} {
  130.             set what [tk_messageBox  -title $labelCurlCodes($code)          \
  131.                       -type yesno    -message $labelMessages(timeoutCont) \
  132.                       -icon question -parent $::Ventana::window(top)]
  133.             if {$what=="yes"} {
  134.                 set getleftState(noConnect,$siteUrl(www)) 0
  135.                 return 0
  136.             }
  137.         }
  138.         set getleftOptions(stopFile) 1
  139.         return 1
  140.     }
  141.     return 0
  142. }
  143.  
  144. ###############################################################################
  145. # RelocatedLink
  146. #    This procedure is invoked when the server tells us that a link has
  147. #    been moved to another place. The link is filtered according to the
  148. #    options set by the user and, if it is the very first file in a
  149. #    download, the user is asked whether to follow or not.
  150. #
  151. # Parameter:
  152. #    link: The original link.
  153. #    newLink: The url after the relocation.
  154. #    referer: Referrer of the link.
  155. #
  156. # Returns:
  157. #    - '0' we follow the redirection.
  158. #    - '1' we don't follow, the files is put in the 'filesNotFound' array, so
  159. #      we don't lose time trying again.
  160. ###############################################################################
  161. proc RelocatedLink {link newLink referer} {
  162.     global getleftState labelTitles labelMessages labelDialogs siteUrl
  163.     global directories
  164.     variable relocated
  165.     variable relocatedLink
  166.     variable filesNotFound
  167.     variable filesRelocated
  168.  
  169.     if {$referer=="-"} {
  170.         set referer $getleftState(url)
  171.     }
  172.     set newLink [::HtmlParser::CompleteUrl $newLink $referer ""]
  173.     set relocated(url) $newLink
  174.     set parsedUrl [HtmlParser::ParseUrl $newLink]
  175.     if {$parsedUrl==1} {
  176.         return 1
  177.     }
  178.  
  179.     if {($getleftState(filesChosen)==0)&&($getleftState(autoDown)==0)} {
  180.         set what [tk_messageBox -title $labelTitles(relocation) -type yesno \
  181.                 -icon question -parent $::Ventana::window(top)              \
  182.                 -message "$labelMessages(follow)\n$newLink"]
  183.         if {$what=="no"} {
  184.             return 1
  185.         }
  186.         set siteUrl(www)  [lindex $parsedUrl 1]
  187.         set siteUrl(dir)  [lindex $parsedUrl 2]
  188.  
  189.         return 0
  190.     }
  191.     set relocatedLink(1,url)  $newLink
  192.     set relocatedLink(1,ok)   1
  193.     set relocatedLink(1,file) [::Commands::UrlToFile $newLink $directories(base)]
  194.  
  195.     ::HtmlParser::FilterLinks $referer Descargar::relocatedLink 0
  196.  
  197.     set filesRelocated($link,url)  $newLink
  198.     set filesRelocated($link,ok)   $relocatedLink(1,ok)
  199.     set filesRelocated($link,file) $relocatedLink(1,file)
  200.     if {[regexp {\.html?} $relocatedLink(1,file)]} {
  201.         set filesRelocated($link,html) 1
  202.     } else {
  203.         set filesRelocated($link,html) 0
  204.     }
  205.  
  206.     if {$relocatedLink(1,ok)==1} {
  207.         ::getLog::FileLogEnter                                              \
  208.                 $labelDialogs(relocation) $link $referer
  209.         ::getLog::FileLogEnter "" "$newLink" "$link"
  210.         return 0
  211.     }
  212.     ::getLog::FileLogEnter                                                  \
  213.             "$labelMessages(noFollow)" "$link" "$referer"
  214.     ::getLog::FileLogEnter "" "$newLink" "$link"
  215.  
  216.     return 1
  217. }
  218.  
  219. ###############################################################################
  220. # UpdateFile
  221. #    Checks whether the file in the server is newer than the one we have.
  222. #
  223. # Parameter:
  224. #    fileName: Name of the file to check
  225. #
  226. # Returns:
  227. #    - '1' if we have to update
  228. #    - '0' if not
  229. ###############################################################################
  230. proc UpdateFile {fileName} {
  231.     global ::Ventana::Rizo::meta
  232.     global getleftState getleftOptions
  233.     global labelTitles labelMessages
  234.  
  235.     if {[file exists $fileName.orig]} {
  236.         set oldFile [file mtime $fileName.orig]
  237.     } elseif {[file exists $fileName.html.orig]} {
  238.         set oldFile [file mtime $fileName.html.orig]
  239.     } else {
  240.         set oldFile [file mtime $fileName]
  241.     }
  242.     if {[catch "set meta(lastModified)"]} {
  243.         if {$getleftState(filesChosen)==0} {
  244.             set which [tk_messageBox -icon info -type yesno \
  245.                     -title $labelTitles(error) \
  246.                     -message $labelMessages(noDate)]
  247.             if {$which=="no"} {
  248.                 set getleftOptions(stopFile) 1
  249.                 return 0
  250.             }
  251.         }
  252.         set lastChange 0
  253.     } else {
  254.         set lastChange [clock scan $meta(lastModified)]
  255.     }
  256.     if {$lastChange<$oldFile} {
  257.         return 0
  258.     }
  259.     return 1
  260. }
  261.  
  262. ###############################################################################
  263. # DownloadHead
  264. #    Downloads the headers of the link
  265. #
  266. # Parameter:
  267. #    link:    Link to download
  268. #    referer: Referrer page
  269. #    sufix: '1' if the link has a 'html' extension.
  270. #
  271. # Returns:
  272. #    - '4' in case of a relocation and a HTML page
  273. #    - '3' in case of a relocation and not a HTML page
  274. #    - '2' in case of error
  275. #    - '1' if it is a HTML page
  276. #    - '0' if it is not
  277. ###############################################################################
  278. proc DownloadHead {link referer sufix} {
  279.     global Ventana::Rizo::meta
  280.     global siteUrl getleftState  directories
  281.     global errorCode labelTitles labelMessages
  282.     variable filesNotFound
  283.     variable relocated
  284.  
  285.     for {set relocated(ok) 0} {1==1} {} {
  286.         for {} {1==1} {} {
  287.             Ventana::HeadDownloading $link $referer
  288.             if {($::Ventana::Rizo::curlError==7)||($::Ventana::Rizo::curlError==28)||($::Ventana::Rizo::curlError==52)} {
  289.                 if {[ConnectTimeout $link $referer $::Ventana::Rizo::curlError]==1} {
  290.                     return 2
  291.                 }
  292.             } else {
  293.                 break
  294.             }
  295.         }
  296.         if {($::Ventana::Rizo::curlError!=0)||($::Ventana::Rizo::errorMessage!="")} {
  297. #            if {$::DEBUG==1} {
  298. #                tk_messageBox -type ok -icon error -title "cURL error" \
  299.                     -message "cURL reported error: $::Ventana::Rizo::curlError\
  300.                               \n$::Ventana::Rizo::errorMessage\n$link"
  301. #            }
  302.             if {$::Ventana::Rizo::errorMessage=="Proxy requires authorization!"} {
  303.                 tk_messageBox -type ok -icon error -title $labelTitles(error) \
  304.                         -message $labelMessages(proxyAuthFail)
  305.                 return 2
  306.             }    
  307.             set code [lindex $errorCode 2]
  308.             ::getLog::FileLogEnter $code "$link" "$referer"
  309.             if {$code>=400} {
  310.                 set filesNotFound($link) 1
  311.             }
  312.             if {($code!=550)&&($code!=450)} {        
  313.                 return 2
  314.             }        
  315.         }
  316.         if {$meta(relocate)!=""} {
  317. #            set filesNotFound($link) 1
  318.             if {$::DEBUG==1} {
  319.                 puts "Relocated: $meta(relocate)"
  320.             }
  321.             set returnCode [RelocatedLink $link $meta(relocate) $referer]
  322.             if {$returnCode==1} {
  323.                 return 2
  324.             }
  325.  
  326.             set parsedUrl [HtmlParser::ParseUrl $relocated(url)]
  327.             set newWWW    [lindex $parsedUrl 1]
  328.             set newDir    [lindex $parsedUrl 2]
  329.  
  330.             set fileName  [::Commands::UrlToFile $relocated(url) $directories(base)]
  331.             set link      $relocated(url)
  332.             set relocated(ok) 1
  333.             if {[file exists $fileName]} {
  334.                 if {([regexp -nocase {\.html?$} $fileName])\
  335.                         ||([file exists $fileName.html])} {
  336.                     set isHtml 1
  337.                 } else {
  338.                     set isHtml 0
  339.                 }
  340.                 return [expr {3 + $isHtml}]
  341.             }
  342.         } else {
  343.             break
  344.         }
  345.     }
  346. # Some servers don't return a mime time, that's why we also check the sufix
  347.     if {($meta(content)!="text/html")&&(![regexp {html?$} $link])} { 
  348.         return 0
  349.     }
  350.     return 1
  351. }
  352.  
  353.  
  354. ###############################################################################
  355. # DownloadFile
  356. #    Downloads the link
  357. #
  358. # Parameter:
  359. #    link:     Link to download
  360. #    referer:  referrer page
  361. #    fileName: file is which the link will be saved.
  362. #
  363. # Returns:
  364. #    - '1' in case of error
  365. #    - '0' all is well
  366. ###############################################################################
  367. proc DownloadFile {link referer fileName} {
  368.     global labelMessages getleftOptions errorCode
  369.  
  370.     set Ventana::Rizo::curlReport(parar)    0
  371.     set Ventana::Rizo::curlReport(nextFile) 0
  372.     for {} {1==1} {} {
  373.         Ventana::FileDownloading $fileName.$labelMessages(downSuffix) \
  374.                 $link $referer
  375.         tkwait variable Ventana::Rizo::curlReport(nextFile)
  376.         if {($::Ventana::Rizo::curlError==7)||($::Ventana::Rizo::curlError==28)||($::Ventana::Rizo::curlError==52)} {
  377.             if {[ConnectTimeout $link $referer $::Ventana::Rizo::curlError]==1} {
  378.                 return 1
  379.             } else {
  380.                 continue
  381.             }
  382.         }
  383.         break
  384.     }
  385.  
  386.     if {$::Ventana::Rizo::curlError!=0} {
  387.         if {$::DEBUG==1} {
  388.             tk_messageBox -type ok -icon error -message "$::errorCode\n$::errorInfo"
  389.         }
  390.         ::getLog::FileLogEnter [lindex $errorCode 2] "$link" "$referer"
  391.         return 1
  392.     }
  393.  
  394.     # Maybe we should say something in the error log
  395.     if {$getleftOptions(cancelDown)==1} {
  396.         return 1
  397.     }
  398.  
  399.     return 0
  400. }
  401.  
  402. ###############################################################################
  403. # Download
  404. #    Downloads a link
  405. #
  406. # Parameter:
  407. #    link:     Link to download
  408. #    referer:  referrer page
  409. #    sufix:    Whether the file ends in 'htm?' (1) or not (0)
  410. #
  411. # Returns:
  412. #    - '4' in case of a relocation and a HTML page
  413. #    - '3' in case of a relocation and not a HTML page
  414. #    - '2' in case of error
  415. #    - '1' if it is a HTML page
  416. #    - '0' if it is not
  417. ###############################################################################
  418. proc Download {link referer sufix} {
  419.     global siteUrl downOptions getleftOptions errorCode getleftState
  420.     global Ventana::Rizo::meta
  421.     global directories
  422.     global labelDialogs labelMessages
  423.     variable downloaded
  424.     variable filesNotFound
  425.     variable filesRelocated
  426.     variable relocated
  427.  
  428.     if {[info exists filesNotFound($link)]} {
  429.         return 2
  430.     }
  431.  
  432.     if {[info exists filesRelocated($link,url)]} {
  433.         set relocated(ok)  1
  434.         set relocated(url) $filesRelocated($link,url)
  435.         return [expr $filesRelocated($link,html)+3]
  436.     }
  437.  
  438.     set fileName [Commands::UrlToFile $link $directories(base)]
  439. #puts "El nombre del fichero: $fileName"
  440.     set returnCode [FileExists $link $fileName $sufix]
  441.     if {$returnCode!=-1} {
  442.         return $returnCode
  443.     } else {
  444.         set downloaded($fileName) 1
  445.     }
  446.  
  447.     set returnCode [DownloadHead $link $referer $sufix]
  448.     switch -regexp -- $returnCode {
  449.         {0|1}   "set isHtml $returnCode"
  450.         {2|3|4} "return $returnCode"
  451.     }        
  452.     if {$getleftOptions(cancelDown)} {
  453.         return 2
  454.     }
  455.     if {$relocated(ok)==1} {
  456.         set link $relocated(url)
  457.         set fileName [::Commands::UrlToFile $link $directories(base)]
  458.  
  459.     }
  460.     if {($isHtml==0)&&($downOptions(onlyHtml)==1)} {
  461.         getLog::FileLogEnter "$labelMessages(noFollow)" "$link" "$referer"
  462.         return 0
  463.     }
  464.     if {($getleftState(filesChosen)==0)&&($isHtml==0)} {
  465.         set fileName $directories(base)/[file tail $fileName]
  466.     }
  467.  
  468.     set returnCode [CheckDir $fileName]
  469.     if {$returnCode==1} {
  470.         getLog::FileLogEnter "Bad dir" "$link" "$referer"
  471.         return 2
  472.     }
  473.     regexp {(.*)(://)} $link nada prot
  474.  
  475.     if {($downOptions(update)==1)&&([file exists $fileName])} {
  476.         if {![UpdateFile $fileName]} {
  477.             return $isHtml
  478.         }
  479.     }
  480.     if {[DownloadFile $link $referer $fileName]} {
  481.         return 2
  482.     }
  483.     # With CGI links it may happen that a file and a directory have the same
  484.     # name.
  485.     if {[file isdirectory $fileName]} {
  486.         file rename -force $fileName.$labelMessages(downSuffix) $fileName.html
  487.     } else {
  488.         catch {file rename -force $fileName.$labelMessages(downSuffix) $fileName}
  489.     }
  490.     if {$isHtml==1} {
  491.         if {[info exists $fileName.html.orig]} {
  492.             file delete $fileName.html.orig
  493.         } else {
  494.             file delete $fileName.orig
  495.         }
  496.     }
  497.  
  498.     if {$relocated(ok)==1} {
  499.         return [expr {3 + $isHtml}]
  500.     }
  501.     if {[catch {file size $fileName} size]} {
  502.         set size 0
  503.     }
  504.     getLog::FileLogEnter 0 $link "$referer" "$size"
  505.  
  506.     return $isHtml
  507. }
  508.  
  509. ###############################################################################
  510. # ProcessUrl
  511. #    Check whether the html link we have has already been processed for links.
  512. #    If it has we only may to process it again if we have a limited number
  513. #    of levels to process.
  514. #
  515. # Parameters:
  516. #    urlToCheck: the url to process for links.
  517. #    level: the recursion level in which we found the link.
  518. #
  519. # Returns
  520. #    '1' if we have to process the links
  521. #    '0' if we do not.
  522. ###############################################################################
  523. proc ProcessUrl {urlToCheck level} {
  524.     global   urlsDownloaded downOptions getleftState directories
  525.     variable filesProcessed
  526.     variable fileFoundAt
  527.  
  528.     set fileName [Commands::UrlToFile $urlToCheck $directories(base)]
  529.  
  530.     if {[info exists filesProcessed($fileName)]} {
  531.         if {($downOptions(levels)==-1)||($level>=$filesProcessed($fileName))} {
  532.             return 0
  533.         }
  534.     }
  535.     if {[info exists fileFoundAt($urlToCheck)]} {
  536.         if {$fileFoundAt($urlToCheck)<$level} {
  537.             return 0
  538.         }
  539.     }
  540.     set filesProcessed($fileName) $level
  541.  
  542.     return 1
  543. }
  544.  
  545. ###############################################################################
  546. # DownloadLinks
  547. #    Download all the links taken from a referrer page.
  548. #
  549. # Parameters:
  550. #    urlList: list with the urls to be downloaded.
  551. #    referer: html page from which the links come from.
  552. #    level:   level of recursion in which we found the link.
  553. #
  554. # Returns
  555. #    The link list with only the Html links.
  556. ###############################################################################
  557. proc DownloadLinks {urlList referer level} {
  558.     global downOptions getleftOptions directories
  559.     variable relocated
  560.  
  561.     set invokeSed 0
  562.  
  563.     set urlListTemp ""
  564.     foreach urlToDownload $urlList {
  565.         update
  566.         if {$downOptions(onlyHtml)==1} {
  567.             if {[regexp -nocase -expanded {(jpg)|(jpeg)|(gif)|(gz) |(tar) |(zip)|     \
  568.                                            (exe)|(ps)  |(pdf)|(txt)|(text)|(avi)|     \
  569.                                            (ram)|(wav) |(png)|(tif)|(mov) |(qt) |     \
  570.                                            (js) |(rpm)} \
  571.                 [file extension $urlToDownload]]} {
  572.                 continue
  573.             }
  574.         }
  575.         set fileName [Commands::UrlToFile $urlToDownload $directories(base)]
  576.         set changedPageLink [Commands::RelativePath $referer $urlToDownload]
  577.  
  578.         set tag ""
  579. #        regexp {(#.*)} $urlToDownload tag
  580.         regexp {([^#]+)(#.*)} $urlToDownload nada urlToDownload tag
  581.         if {[regexp {/$} $urlToDownload]} {
  582.             if {[ProcessUrl $urlToDownload $level]} {
  583.                 set urlToDownload ${urlToDownload}index.html
  584.                 lappend urlListTemp $urlToDownload
  585.             }
  586.         }
  587.  
  588.         if {[regexp -nocase {\.html?$} $urlToDownload]} {
  589.             set sufix 1
  590.         } else {
  591.             set sufix 0
  592.         }
  593.  
  594.         set isHtml [Download $urlToDownload $referer $sufix]
  595.  
  596.         set urlsDownloaded($urlToDownload) $level
  597.         switch -regexp -- $isHtml {
  598.             1 {
  599.                 if {$sufix==0} {
  600.                     if {[file size $fileName]!=0} {
  601.                         catch {file rename -force $fileName $fileName.html}
  602.                         Commands::Touch $fileName
  603.                     }
  604.                     if {[ProcessUrl $urlToDownload $level]} {
  605.                         lappend urlListTemp $urlToDownload.html
  606.                     }
  607.                     Commands::SedChangeEnter $changedPageLink$tag          \
  608.                                              ${changedPageLink}.html$tag
  609.                     set invokeSed 1
  610.                 } else {
  611.                     if {[ProcessUrl $urlToDownload $level]} {
  612.                         lappend urlListTemp $urlToDownload
  613.                     }
  614.                 }
  615.             }
  616.             {3|4} {
  617.                 set newLink [::Commands::RelativePath $referer $relocated(url)]
  618.                 set sufix [regexp -nocase {\.html?$} [file extension $newLink]]
  619.                 if {$isHtml==4} {
  620.                     if {$sufix==0} {
  621.                         if {[ProcessUrl $urlToDownload $level]} {
  622.                             lappend urlListTemp $relocated(url).html
  623.                         }
  624.                         set localFileName [::Commands::UrlToFile $relocated(url) $directories(base)]
  625.                         if {(![regexp -nocase {\.html?$} $localFileName])&&(![file exists $localFileName.html])} {
  626.                             file rename -force $localFileName $localFileName.html
  627.                             Commands::Touch $localFileName
  628.                         }
  629.                         set newLink $newLink.html
  630.                     } else {
  631.                         if {[ProcessUrl $urlToDownload $level]} {
  632.                             lappend urlListTemp $relocated(url)
  633.                         }
  634.                     }
  635.                 }
  636.                 Commands::SedChangeEnter $changedPageLink$tag $newLink$tag
  637.                 set invokeSed 1
  638.             }
  639.         }
  640.         if {$getleftOptions(stopFile)==1} {
  641.             break
  642.         }
  643.         if {$getleftOptions(pauseFile)==1} {
  644.             Ventana::Pause file
  645.         }
  646.     }
  647.     if {$invokeSed==1} {
  648.         Commands::Sed [::Commands::UrlToFile $referer $directories(base)]
  649.     }
  650.     return $urlListTemp
  651. }
  652.  
  653. ###############################################################################
  654. # Preprocessing
  655. #    Reads the Web page passed as a parameter and proccess it to extract
  656. #    all the links has.
  657. #
  658. # Parameters:
  659. #    url: url of the page where are going to process for links.
  660. #    level: Level of recursion in which the file is processed.
  661. #    externalLevel: The level of recursion for links outside the domain.
  662. ###############################################################################
  663. proc Preprocessing {url level {externalLevel 0}} {
  664.     global directories getleftState charSets
  665.  
  666.     if {[string match $url ""]} return
  667.     set file [Commands::UrlToFile $url $directories(base)]
  668.     if {([file exists $file.html])&&([file size $file]==0)} {
  669.         set file $file.html
  670.     }
  671.  
  672.     set ::HtmlParser::nLinks 1
  673.  
  674.     if {![regexp -nocase {\.html?$} $file]} return
  675.  
  676.     set directories(local) [file dirname $file]
  677.  
  678.     if {$getleftState(filesChosen)==1} {
  679.         Ventana::ShowWindow  process
  680.         Ventana::FileStrings $url
  681.     }
  682.  
  683.     if {[file exists $file.orig]} {
  684.         set fileName $file.orig
  685.     } else {
  686.         set fileName $file
  687.     }
  688.     set returnCode [HtmlParser::Parsing $fileName $url $level]
  689.     if {$returnCode==1} {
  690.         if {$::DEBUG==1} {
  691.             tk_messageBox -type ok -icon error -type ok \
  692.                     -message "Could not process:\n $fileName"
  693.         }
  694.         return
  695.     }
  696.  
  697.     if {$getleftState(filesChosen)==0} {
  698.         set encoding ""
  699.         catch {set encoding $charSets($Ventana::Rizo::meta(charSet))}
  700.         if {$HtmlParser::pageEncoding!=""} {
  701.             if {[catch {set charSets($HtmlParser::pageEncoding)} encoding]} {
  702.                 set encoding ""
  703.             }
  704.         }
  705.         if {$encoding!=""} {
  706.             HtmlParser::ChangeEncoding $encoding
  707.         }
  708.     }
  709.  
  710.     HtmlParser::FilterLinks $url ::HtmlParser::links $level $externalLevel
  711.  
  712.     update
  713.     ::Commands::ChangePage $url
  714.  
  715.     return
  716. }
  717.  
  718. ###############################################################################
  719. # PrepareDownloading
  720. #    Prepares the list of files to download from the data in the
  721. #    HtmlParser::nLinks array.
  722. #
  723. # Parameter
  724. #    currentLevel: the current level of recursion
  725. #
  726. # Returns
  727. #    The list with the urls to be downloaded.
  728. ###############################################################################
  729. proc PrepareDownloading {currentLevel} {
  730.     global siteIndex siteMap downOptions getleftState
  731.     variable fileFoundAt
  732.  
  733.     for {set i 1 ; set urlList ""} {$i<$HtmlParser::nLinks} {incr i} {
  734.         set url $HtmlParser::links($i,url)
  735.         if {[info exists fileFoundAt($url)]} {
  736.             if {$fileFoundAt($url)>$currentLevel} {
  737.                 set fileFoundAt($url) $currentLevel
  738.             }
  739.         } else {
  740.             set fileFoundAt($url) $currentLevel
  741.         }
  742.         if {$HtmlParser::links($i,ok)==1} {
  743.             lappend urlList $url
  744.         }
  745.         if {$downOptions(map)==1} {
  746.             set siteMap($siteIndex,level)       $currentLevel
  747.             set siteMap($siteIndex,url)         $url
  748.             set siteMap($siteIndex,file)        $HtmlParser::links($i,file)
  749.             set siteMap($siteIndex,descrip)     $HtmlParser::links($i,descrip)
  750.             catch {set siteMap($siteIndex,type) $HtmlParser::links($i,type)}
  751.             set siteMap($url) 1
  752.             incr siteIndex
  753.         }
  754.     }
  755.     if {$getleftState(filesChosen)==0} {
  756.         set getleftState(filesChosen) 1
  757.     }
  758.     return $urlList
  759. }
  760.  
  761. ###############################################################################
  762. # ControlDownloading
  763. #    Sends 'Downloading' all the links one by one.
  764. #
  765. # Parameters:
  766. #    referer: html page from which the links come from.
  767. #    level: current level of recursion for internal links.
  768. #    externalLevel: current level of recursion for external links.
  769. ###############################################################################
  770. proc ControlDownloading {referer level {externalLevel 0}} {
  771.     global siteUrl directories getleftOptions getleftState downOptions
  772.     variable filesProcessed
  773.     variable oneHundredLosers
  774.  
  775.     if {$getleftState(downloading)==0} return
  776.  
  777.     if {$level==99} {
  778.         # We have to do this because of the 100 recursion limit 
  779.         # compiled in by default into Tcl, we have to save these
  780.         # urls to process later.
  781.         catch {unset filesProcessed([Commands::UrlToFile $referer])}
  782.         set oneHundredLosers($referer) 1
  783.         return
  784.     }
  785.  
  786.     set urlList [PrepareDownloading $level]
  787.     if {[llength $urlList]==0} return
  788.  
  789.     if {($getleftOptions(stopFile)!=1)&&($getleftOptions(stopPage)!=1)} {
  790.         set urlList [DownloadLinks $urlList $referer $level]
  791.         if {$getleftOptions(pausePage)==1} {
  792.             Ventana::Pause page
  793.         }
  794.     } else {
  795.         return
  796.     }
  797.  
  798.     foreach url $urlList {
  799.         set parsedUrl       [HtmlParser::ParseUrl $url]
  800.         set domain          [lindex $parsedUrl 1]
  801.  
  802.         if {[string compare [string tolower $domain]                            \
  803.                 [string tolower $siteUrl(www)]]} {
  804.             set nextExternalLevel [expr {$externalLevel + 1}]
  805.         } else {
  806.             set nextExternalLevel 0
  807.         }
  808.  
  809.         Preprocessing $url $level $nextExternalLevel
  810.         if {$HtmlParser::nLinks!=1} {
  811.             set nextLevel [expr {$level +1}]
  812.             ControlDownloading $url $nextLevel $nextExternalLevel
  813.             if {($getleftOptions(stopFile)==1)||($getleftOptions(stopPage)==1)} {
  814.                 return
  815.             }
  816.         }
  817.     }
  818.     return
  819. }
  820.  
  821. }
  822.